Analiza meteriałów używanych w bateriach

Podsumowanie

Celem niniejszej analizy było zbadanie danych dotyczących baterii oraz stworzenie modelu predykcyjnego dla średniego napięcia na podstawie pozostałych atrybutów baterii. Analiza została przeprowadzona na podstawie zbioru danych udostępnionego przez Materials Project, inicjatywę naukową Departamentu Energii USA. Po przeprowadzeniu analizy stwierdzono, że największy wpływ na średnią wartość napięcia baterii miała energia wolumetryczna.

Wykorzystane biblioteki

W raporcie wykorzystano następujące biblioteki:

library(knitr)
library(dplyr)
library(tidyr)
library(ggplot2)
library(plotly)
library(ggcorrplot)
library(caret)
library(tibble)
library(kableExtra)

Wczytanie danych

Materials Project to inicjatywa naukowa Departamentu Energii USA, której celem jest dostarczanie otwartych danych i narzędzi do analizy materiałów. Jednym z kluczowych zbiorów danych dostępnych w ramach Materials Project jest baza danych dotycząca materiałów używanych w bateriach, która zawiera informacje o ich składzie chemicznym i parametrach wydajnościowych.

df <- read.csv("./data/mp_batteries.csv", na.strings="?")
df <- tbl_df(df)

Opis atrybutów

Nazwa atrybutu	Opis
Battery ID	Identyfikator baterii.
Battery Formula	Wzór chemiczny materiału baterii.
Working Ion	Główny jon, który odpowiada za transport ładunku w baterii.
Formula Charge	Wzór chemiczny materiału baterii w stanie naładowanym.
Formula Discharge	Wzór chemiczny materiału baterii w stanie rozładowanym.
Max Delta Volume	Zmiana objętości w % dla danego kroku napięcia za pomocą wzoru : max(charge, discharge)/min(charge, discharge) -1.
Average Voltage	Średnie napięcie dla poszczególnego kroku napięcia.
Gravimetric Capacity	Pojemność grawimetryczna, czyli ilość energii na jednostkę masy (mAh/g).
Volumetric Capacity	Pojemność wolumetryczna, czyli ilość energii na jednostkę objętości (mAh/cm³).
Gravimetric Energy	Gęstość energii w odniesieniu do masy baterii (Wh/kg).
Volumetric Energy	Gęstość energii w odniesieniu do objętości baterii (Wh/L).
Atomic Fraction Charge	Udział atomowy składników w stanie naładowanym.
Atomic Fraction Discharge	Udział atomowy składników w stanie rozładowanym.
Stability Charge	Wskaźnik stabilności materiału w stanie naładowanym.
Stability Discharge	Wskaźnik stabilności materiału w stanie rozładowanym.
Steps	Liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana, oparta na stabilnych stanach pośrednich.
Max Voltage Step	Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia.

Czyszczenie zbioru danych

Poniżej znajduje się lista kroków wykonanych na zbiorze danych w celu przygotowania go do anaizy.

Struktura danych

Struktura ramki danych
tibble [4,351 × 17] (S3: tbl_df/tbl/data.frame)
$ Battery.ID : chr [1:4351] “mp-30_Al” “mp-1022721_Al” “mp-8637_Al” “mp-129_Al” …
$ Battery.Formula : chr [1:4351] “Al0-2Cu” “Al1-3Cu” “Al0-5Mo” “Al0-12Mo” …
$ Working.Ion : chr [1:4351] “Al” “Al” “Al” “Al” …
$ Formula.Charge : chr [1:4351] “Cu” “AlCu” “Mo” “Mo” …
$ Formula.Discharge : chr [1:4351] “Al2Cu” “Al3Cu” “Al5Mo” “Al12Mo” …
$ Max.Delta.Volume : num [1:4351] 3.04 1.24 4.76 12.72 12.49 …
$ Average.Voltage : num [1:4351] 0.089 -0.0216 0.1228 0.0431 0.0292 …
$ Gravimetric.Capacity : num [1:4351] 1368 1113 1742 2299 1901 …
$ Volumetric.Capacity : num [1:4351] 5563 4419 7176 7346 7333 …
$ Gravimetric.Energy : num [1:4351] 121.8 -24 213.8 99.1 55.6 …
$ Volumetric.Energy : num [1:4351] 495.3 -95.4 880.9 316.8 214.4 …
$ Atomic.Fraction.Charge : num [1:4351] 0 0.5 0 0 0 …
$ Atomic.Fraction.Discharge: num [1:4351] 0.667 0.75 0.833 0.923 0.923 …
$ Stability.Charge : num [1:4351] 0 0.0741 0.4115 0 0 …
$ Stability.Discharge : num [1:4351] 0 0.0962 0.0452 0.0114 0 …
$ Steps : int [1:4351] 1 1 1 1 1 1 1 1 1 1 …
$ Max.Voltage.Step : num [1:4351] 0 0 0 0 0 0 0 0 0 0 …

Kilka pierwszych wierszy ze zbioru danych

Battery.ID	Battery.Formula	Working.Ion	Formula.Charge	Formula.Discharge	Max.Delta.Volume	Average.Voltage	Gravimetric.Capacity	Volumetric.Capacity	Gravimetric.Energy	Volumetric.Energy	Atomic.Fraction.Charge	Atomic.Fraction.Discharge	Stability.Charge	Stability.Discharge	Steps	Max.Voltage.Step
mp-30_Al	Al0-2Cu	Al	Cu	Al2Cu	3.0433992	0.0890331	1368.48055	5562.7901	121.840086	495.272533	0.0000000	0.6666667	0.0000000	0.0000000	1	0
mp-1022721_Al	Al1-3Cu	Al	AlCu	Al3Cu	1.2436528	-0.0215863	1112.93655	4418.9798	-24.024232	-95.389622	0.5000000	0.7500000	0.0740612	0.0962458	1	0
mp-8637_Al	Al0-5Mo	Al	Mo	Al5Mo	4.7625743	0.1227568	1741.50416	7175.7017	213.781556	880.866507	0.0000000	0.8333333	0.4114601	0.0452120	1	0
mp-129_Al	Al0-12Mo	Al	Mo	Al12Mo	12.7238931	0.0431214	2298.81076	7346.2323	99.128013	316.780060	0.0000000	0.9230769	0.0000000	0.0114456	1	0
mp-91_Al	Al0-12W	Al	W	Al12W	12.4945977	0.0292342	1900.74513	7332.7186	55.566774	214.366205	0.0000000	0.9230769	0.0000000	0.0000000	1	0
mp-1055908_Al	Al0-12Mn	Al	Mn	MnAl12	18.2361563	0.0397314	2547.69280	7592.9161	101.223298	301.676876	0.0000000	0.9230769	0.1454643	0.0000000	1	0
mp-2658_Al	Al0-1Fe	Al	Fe	AlFe	0.7711539	0.4717287	970.75702	5622.3562	457.933974	2652.226958	0.0000000	0.5000000	0.7613994	0.0000000	1	0
mp-16722_Al	Al1-10.25V	Al	Al10V	Al41V4	0.0027108	-0.0155827	61.37701	176.4151	-0.956421	-2.749028	0.9090909	0.9111111	0.0118097	0.0125861	1	0
mp-998981_Al	Al1-3Ti	Al	TiAl	TiAl3	0.9562924	0.1602450	1248.40362	4248.4211	200.050419	680.788169	0.5000000	0.7500000	0.1415912	0.0244962	1	0
mp-8633_K	K0-3Cr	K	Cr	K3Cr	15.8029363	-0.7487069	474.94813	667.5593	-355.596958	-499.806269	0.0000000	0.7500000	0.4025263	0.6621618	1	0
mp-8640_K	K0-3Hf	K	Hf	K3Hf	7.6097655	-1.4790313	271.83417	689.1858	-402.051260	-1019.327437	0.0000000	0.7500000	0.0724082	1.1273756	1	0
mp-8634_K	K0-3Mn	K	Mn	K3Mn	16.9232363	-0.8393424	466.83544	689.3385	-391.834783	-578.591003	0.0000000	0.7500000	0.0830981	0.6502813	1	0
mp-8637_K	K0-3Mo	K	Mo	K3Mo	11.2468574	-1.4178585	377.06981	675.2837	-534.631623	-957.456674	0.0000000	0.7500000	0.4114601	1.1662589	1	0
mp-8642_K	K0-3Re	K	Re	K3Re	10.3987219	-1.9828195	264.92237	774.8719	-525.293242	-1536.431174	0.0000000	0.7500000	0.0627568	1.5028038	1	0
mp-8632_K	K0-3V	K	V	K3V	13.0605399	-1.0947808	477.92537	681.8803	-523.223504	-746.509444	0.0000000	0.7500000	0.2471404	0.8828707	1	0
mp-8641_K	K0-3W	K	W	K3W	10.1121849	-1.8449306	267.00473	727.0998	-492.605208	-1341.448692	0.0000000	0.7500000	0.4714241	1.5015540	1	0
mp-8634_Ca	Ca0-3Mn	Ca	Mn	Ca3Mn	10.8286680	-0.2316551	918.00542	2089.0224	-212.660602	-483.932614	0.0000000	0.7500000	0.0830981	0.3682571	1	0
mp-8633_Li	Li0-3Cr	Li	Cr	Li3Cr	5.1580521	-0.4076942	1104.16695	1821.5104	-450.162431	-742.619186	0.0000000	0.7500000	0.4025263	0.4064022	1	0
mp-8636_Li	Li0-3Nb	Li	Nb	Li3Nb	2.3814957	-0.8254060	706.98041	2085.1784	-583.545844	-1721.118698	0.0000000	0.7500000	0.3201642	0.6990955	1	0
mp-102_Rb	Rb0-3Co	Rb	Co	Rb3Co	17.4204448	-1.1292823	254.97974	664.1585	-287.944098	-750.022366	0.0000000	0.7500000	0.0161140	0.8509902	1	0
mp-8634_Rb	Rb0-3Mn	Rb	Mn	Rb3Mn	20.6965362	-0.8831153	258.25166	569.4539	-228.065988	-502.893416	0.0000000	0.7500000	0.0830981	0.6831110	1	0
mp-8637_Rb	Rb0-3Mo	Rb	Mo	Rb3Mo	13.4775228	-1.4691341	228.19909	571.2374	-335.255062	-839.224376	0.0000000	0.7500000	0.4114601	1.2047156	1	0
mp-8642_Rb	Rb0-3Re	Rb	Re	Rb3Re	12.2810875	-2.0555178	181.65963	665.0472	-373.404617	-1367.016318	0.0000000	0.7500000	0.0627568	1.5573276	1	0
mp-8632_Rb	Rb0-3V	Rb	V	Rb3V	15.5109635	-1.1510190	261.60982	580.6811	-301.117862	-668.375011	0.0000000	0.7500000	0.2471404	0.9250493	1	0
mp-8641_Rb	Rb0-3W	Rb	W	Rb3W	12.3636271	-1.9016930	182.63634	604.6014	-347.318243	-1149.766201	0.0000000	0.7500000	0.4714241	1.5441257	1	0
mp-102_Na	Na0-3Co	Na	Co	Na3Co	8.0250126	-0.8766266	628.63855	1355.5764	-551.081257	-1188.334319	0.0000000	0.7500000	0.0161140	0.6614984	1	0
mp-23_Na	Na0-3Ni	Na	Ni	Na3Ni	7.9735171	-0.5556719	629.81935	1381.2293	-349.972899	-767.510265	0.0000000	0.7500000	0.0000000	0.4167539	1	0
mp-568345_Na	Na0-3Fe	Na	Fe	Na3Fe	7.1963242	-0.6615578	644.19252	1214.9419	-426.170582	-803.754301	0.0000000	0.7500000	0.7613994	0.6865182	1	0
mp-8642_Na	Na0-3Re	Na	Re	Na3Re	5.8592848	-1.7147724	315.09369	1287.6779	-540.313949	-2208.074566	0.0000000	0.7500000	0.0627568	1.3017685	1	0
mp-567597_Y	Y0-3Bi	Y	Bi	Y3Bi	2.3251246	0.1547191	507.07246	3420.2399	78.453815	529.176575	0.0000000	0.7500000	0.0495452	0.1487189	1	0

Analiza jakości danych

Sprawdzenie ile jest pustych wartościami w poszczególnych kolumnach oraz ile w zbiorze jest zduplikowanych wierszy.

na_counts <- colSums(is.na(df))
kable(na_counts, col.names = c("Brakujące wartości"), caption = "Liczba brakujących wartości w kolumnach")

Liczba brakujących wartości w kolumnach

	Brakujące wartości
Battery.ID	0
Battery.Formula	0
Working.Ion	0
Formula.Charge	0
Formula.Discharge	0
Max.Delta.Volume	0
Average.Voltage	0
Gravimetric.Capacity	0
Volumetric.Capacity	0
Gravimetric.Energy	0
Volumetric.Energy	0
Atomic.Fraction.Charge	0
Atomic.Fraction.Discharge	0
Stability.Charge	0
Stability.Discharge	0
Steps	0
Max.Voltage.Step	0

duplicates_count <- sum(duplicated(df))

Liczba zduplikowanych wierszy: 0.

Z powodu braku zduplikowanych danych oraz braku wartości pustych w zbiorze - dane nie wymagają czyszczenia.

Podstawowe statystyki

Zbiór danych składa się z 4351 wierszy (obserwacji) i 17 kolumn (atrybutów).

kable(summary(df %>% select(Max.Delta.Volume:Volumetric.Energy)))

	Max.Delta.Volume	Average.Voltage	Gravimetric.Capacity	Volumetric.Capacity	Gravimetric.Energy	Volumetric.Energy
	Min. : 0.00002	Min. :-7.755	Min. : 5.176	Min. : 24.08	Min. :-583.5	Min. :-2208.1
	1st Qu.: 0.01747	1st Qu.: 2.226	1st Qu.: 88.108	1st Qu.: 311.62	1st Qu.: 211.7	1st Qu.: 821.6
	Median : 0.04203	Median : 3.301	Median : 130.691	Median : 507.03	Median : 401.8	Median : 1463.8
	Mean : 0.37531	Mean : 3.083	Mean : 158.291	Mean : 610.62	Mean : 444.1	Mean : 1664.0
	3rd Qu.: 0.08595	3rd Qu.: 4.019	3rd Qu.: 187.600	3rd Qu.: 722.75	3rd Qu.: 614.4	3rd Qu.: 2252.3
	Max. :293.19322	Max. :54.569	Max. :2557.627	Max. :7619.19	Max. :5926.9	Max. :18305.9

kable(summary(df %>% select(Atomic.Fraction.Charge:Max.Voltage.Step)))

	Atomic.Fraction.Charge	Atomic.Fraction.Discharge	Stability.Charge	Stability.Discharge	Steps	Max.Voltage.Step
	Min. :0.00000	Min. :0.007407	Min. :0.00000	Min. :0.00000	Min. :1.000	Min. : 0.0000
	1st Qu.:0.00000	1st Qu.:0.086957	1st Qu.:0.03301	1st Qu.:0.01952	1st Qu.:1.000	1st Qu.: 0.0000
	Median :0.00000	Median :0.142857	Median :0.07319	Median :0.04878	Median :1.000	Median : 0.0000
	Mean :0.03986	Mean :0.159077	Mean :0.14257	Mean :0.12207	Mean :1.167	Mean : 0.1503
	3rd Qu.:0.04762	3rd Qu.:0.200000	3rd Qu.:0.13160	3rd Qu.:0.09299	3rd Qu.:1.000	3rd Qu.: 0.0000
	Max. :0.90909	Max. :0.993333	Max. :6.48710	Max. :6.27781	Max. :6.000	Max. :26.9607

Cechy statystyczne zbioru danych

W tym zbiorze można odczytać następujące cechy statystyczne:

• Wartości skrajne: Zauważalna jest duża zmienność i obecność skrajnych wartości (np. Max.Delta.Volume, Volumetric.Capacity, Gravimetric.Energy), które mogą wymagać dalszej analizy pod kątem anomalii.
• Wartości ujemne: Atrybuty takie jak Average.Voltage, Gravimetric.Energy, Volumetric.Energy zawierają ujemne wartości, co sugeruje możliwość błędów w danych lub specyficzną charakterystykę badanych baterii.
• Skumulowane dane: Większość danych ma bardzo małą zmienność w niektórych atrybutach (np. Steps, Max.Voltage.Step), co może sugerować, że niektóre zmienne są stałe w większości przypadków.

Analiza danych

Poniżej znajduje się analiza zbioru danych w celu zbadania rozkładów wartości poszczególnych atrybutów oraz sprawdzenia występujących między nimi korelacji.

Rozkład wartości atrybutów

p <- ggplot(df, aes(x = `Working.Ion`)) +
  geom_bar(fill = "blue", color = "black") +
  labs(
    title = "Histogram głównego jonu baterii",
    x = "Główny Jon",
    y = "Liczba"
  ) +
  theme_light()

ggplotly(p)

mean <- mean(df$Max.Delta.Volume, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Max.Delta.Volume`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład maksymalnej zmiany objętości dla danego kroku",
    x = "Maksymalna zmiana objętości",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Average.Voltage, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Average.Voltage`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład średniego napięcia",
    x = "Średnie napięcie",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Gravimetric.Capacity, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Gravimetric.Capacity`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład pojemności grawimetrycznej",
    x = "Pojemność grawimetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Volumetric.Capacity, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Volumetric.Capacity`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład pojemności wolumetrycznej",
    x = "Pojemność wolumetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Gravimetric.Energy, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Gravimetric.Energy`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład energii grawimetrycznej",
    x = "Energia grawimetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Volumetric.Energy, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Volumetric.Energy`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład energii wolumetrycznej",
    x = "Energia wolumetryczna",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Atomic.Fraction.Charge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Charge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład udziału atomowego składników w stanie naładowanym",
    x = "Udział atomowy składników",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Atomic.Fraction.Discharge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Atomic.Fraction.Discharge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład udziału atomowego składników w stanie rozładowanym",
    x = "Udział atomowy składników",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Stability.Charge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Stability.Charge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład wskaźnika stabilności materiału w stanie naładowanym",
    x = "Wskaźnik stabilności materiału",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Stability.Discharge, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Stability.Discharge`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład wskaźnika stabilności materiału w stanie rozładowanym",
    x = "Wskaźnik stabilności materiału",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Steps, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Steps`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład liczba odrębnych kroków napięcia od pełnego naładowania do rozładowana",
    x = "Liczba kroków",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

mean <- mean(df$Max.Voltage.Step, na.rm = TRUE)
p1 <- ggplot(df, aes(x = `Max.Voltage.Step`)) +
  geom_histogram(fill = "blue", color = "black", alpha = 0.7) +
  geom_vline(aes(xintercept = mean), color = "red", linetype = "dashed", size = 1) +
  labs(
    title = "Rozkład maksymalnej bezwzględnej różnica między sąsiednimi krokami napięcia",
    x = "Maksymalna bezwzględna różnica między sąsiednimi krokami napięcia",
    y = "Liczba obserwacji"
  ) +
  theme_light()

ggplotly(p1)

Korelacja pomiędzy atrybutami

Poniżej przedstawiono macierz korelacji między wybranymi atrybutami zestawu danych. Kolory kafelków wskazują wartość współczynnika korelacji Pearsona: niebieski reprezentuje silną ujemną korelację, biały brak korelacji, a czerwony silną dodatnią korelację. Liczby na kafelkach przedstawiają dokładne wartości korelacji, co umożliwia szybką analizę zależności między zmiennymi.

cor_matrix <- df %>%
  select(`Max.Delta.Volume`:last_col()) %>%
  cor(method="pearson")

correlation_long <- cor_matrix %>%
  as.data.frame() %>%
  mutate(variable1 = colnames(cor_matrix)) %>%
  pivot_longer(-variable1,
    names_to = "variable2",
    values_to = "correlation"
  ) %>%
  filter(variable1 > variable2)

correlation_plot <- ggplot(
  correlation_long,
  aes(x = variable1, y = variable2, fill = correlation)
) +
  geom_tile() +
  scale_fill_gradient2(
    low = "blue", mid = "white", high = "red",
    midpoint = 0, limits = c(-1, 1)
  ) +
  geom_text(aes(label = sprintf("%.2f", correlation)), size = 3) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    axis.title = element_blank()
  ) +
  labs(fill = "Korelacja")

ggplotly(correlation_plot)

Poniżej przedstawiono wykresy ilustrujące zależności między wybranymi parami atrybutów. Każdy wykres pokazuje punktowy rozkład obserwacji oraz linię trendu wyznaczoną za pomocą modelu liniowego.

plot_correlation <- function(df, var1, var2) {
  ggplot(df, aes_string(x = var1, y = var2)) +
    geom_point(alpha = 0.5, color = "blue") +
    geom_smooth(method = "lm", se = TRUE, color = "red", fill = "pink") +
    theme_minimal() +
    labs(
      title = paste("Korelacja między", var1, "a", var2),
      x = var1,
      y = var2
    ) +
    theme(
      plot.title = element_text(hjust = 0.5, size = 14),
      axis.text = element_text(size = 10),
      axis.title = element_text(size = 11)
    )
}

pairs <- list(
  c("Gravimetric.Energy", "Volumetric.Energy"),
  c("Gravimetric.Capacity", "Volumetric.Capacity"),
  c("Stability.Charge", "Stability.Discharge")
)

for (pair in pairs) {
  print(plot_correlation(df, pair[1], pair[2]))
}

Wnioski z analizy

• Główne jony: Widać wyraźną dominację występowania baterii posiadających Lit (Li) jako główny jon
• Symetryczność wykresów: Większość wykresów ma charakter prawoskośny, co oznacza, że dane są skupione po lewej stronie z długim ogonem w prawo. Może to wskazywać na obecność outlierów (wartości odstających) w danych, które mają duży wpływ na analizowane zmienne.
• Skumulowane dane: Wiele atrybutów (np. Steps, Max.Voltage.Step) ma małą zmienność, a dane są skoncentrowane w wąskim zakresie, co może ograniczać ich wartość predykcyjną.
• Korelacje między atrybutami: Z analizy korelacji wynika, że niektóre atrybuty są ze sobą silnie skorelowane, co sugeruje możliwość ich redukcji lub usunięcia, aby uniknąć problemu multikolinearności w dalszej analizie. Na przykład, atrybuty takie pary jak Gravimetric.Energy i Volumetric.Energy, Gravimetric.Capacity i Volumetric.Capacity, Stability.Charge i Stablility.Discharge wykazują bardzo wysoką dodatnią korelację, co może wpływać na stabilność modeli predykcyjnych.

Regresor

W tej sekcji przedstawiono proces tworzenia modelu regresji, obejmujący redukcję atrybutów o wysokiej korelacji, przygotowanie zbiorów danych oraz trenowanie modelu z wykorzystaniem walidacji krzyżowej. Wyniki modelu zostały ocenione za pomocą metryk jakości oraz wizualnie porównane z danymi testowymi.

Redukcja korelacji

Aby zredukować korelacje między atrybutami, zastosowano funkcję findCorrelation z pakietu caret, ustawiając próg (cutoff) na 0.6. Funkcja ta identyfikuje atrybuty, które są silnie skorelowane i mogą zostać usunięte z analizy.

attributes_to_remove <- cor_matrix %>% findCorrelation(cutoff = 0.6, names = TRUE)

Atrybuty, które zostały wybrane do usunięcia: Gravimetric.Energy, Gravimetric.Capacity, Atomic.Fraction.Discharge, Stability.Charge.

Trenowanie modelu

Do budowy modelu predykcyjnego usunięto atrybuty Gravimetric.Energy, Gravimetric.Capacity, Atomic.Fraction.Discharge, Stability.Charge oraz Battery.ID. Dane zostały podzielone na zbiór uczący (70%) oraz testowy (30%). Dodatkowo, w celu oceny modelu, zastosowano ocenę krzyżową (cross-validation) z 10-krotnym podziałem zbioru danych na podzbiory.

df$Battery.Formula <- as.numeric(factor(df$Battery.Formula))
df$Working.Ion <- as.numeric(factor(df$Working.Ion))
df$Formula.Charge <- as.numeric(factor(df$Formula.Charge))
df$Formula.Discharge <- as.numeric(factor(df$Formula.Discharge))
in_training_data <- createDataPartition(y = df$Average.Voltage, p = 0.70, list = FALSE)

training_data <- df[in_training_data, ] %>% select(-c(Battery.ID, attributes_to_remove))
testing_data <- df[-in_training_data, ]

ctrl <- trainControl(method = "cv", number = 10)

Poniższy wykres przedstawia podobieństwo rozkładów danych treningowych i testowych.

ggplot() +
  geom_density(aes(x = Average.Voltage, fill = "Treningowy"), data = training_data, alpha = 0.6) +
  geom_density(aes(x = Average.Voltage, fill = "Testowy"), data = testing_data, alpha = 0.6) +
  labs(x = "Average Voltage", y = "Gęstość", fill = "Zbiór danych") +
  theme_light()

model_lm <- train(
  Average.Voltage ~ .,
  data = training_data,
  method = "lm",
  trControl = ctrl
)

Podsumowanie modelu

Podsumowanie zawiera szczegółowe informacje o współczynnikach regresji, w tym ich wartości, błędy standardowe, statystyki t oraz p-wartości, co pozwala ocenić znaczenie poszczególnych predyktorów w modelu.

model_summary <- summary(model_lm)

residuals_summary <- data.frame(
  Metric = c("Min", "1Q", "Mediana", "Brak reszty", "3Q", "Max"),
  Value = as.numeric(summary(model_summary$residuals))
)
kable(residuals_summary, caption = "Podsumowanie reszt modelu")

Podsumowanie reszt modelu

Metric	Value
Min	-6.3627997
1Q	-0.6204801
Mediana	-0.0532169
Brak reszty	0.0000000
3Q	0.5494741
Max	23.7898552

kable(as.data.frame(model_summary$coefficients),
      caption = "Podsumowanie wyników modelu liniowego",
      col.names = c("Współczynnik", "Wartość", "Standard Error", "t-Statystyka", "p-Wartość"))

Podsumowanie wyników modelu liniowego

Współczynnik	Wartość	Standard Error	t-Statystyka	p-Wartość
(Intercept)	3.1371173	0.1156145	27.1342824	0.0000000
Battery.Formula	-0.0002763	0.0000541	-5.1046084	0.0000004
Working.Ion	-0.0246354	0.0271988	-0.9057548	0.3651375
Formula.Charge	-0.0001272	0.0000346	-3.6720831	0.0002447
Formula.Discharge	0.0001570	0.0000430	3.6482901	0.0002684
Max.Delta.Volume	0.2317628	0.0253167	9.1545576	0.0000000
Volumetric.Capacity	-0.0013795	0.0000606	-22.7651446	0.0000000
Volumetric.Energy	0.0009911	0.0000209	47.5337868	0.0000000
Atomic.Fraction.Charge	2.5331915	0.4378644	5.7853338	0.0000000
Atomic.Fraction.Discharge	-1.2220230	0.4222202	-2.8942791	0.0038274
Stability.Discharge	-0.4251615	0.0620153	-6.8557546	0.0000000
Steps	-0.2614434	0.0646566	-4.0435684	0.0000540
Max.Voltage.Step	0.1054219	0.0589217	1.7891854	0.0736847

fit_statistics <- data.frame(
  Metric = c("R-squared", "Adjusted R-squared", "Residual Std. Error"),
  Value = c(
    model_summary$r.squared,
    model_summary$adj.r.squared,
    model_summary$sigma
  )
)
kable(fit_statistics, caption = "Statystyki dopasowania modelu")

Statystyki dopasowania modelu

Metric	Value
R-squared	0.5248056
Adjusted R-squared	0.5229261
Residual Std. Error	1.1735086

f_stat <- data.frame(
  Metric = "F-statistic",
  Value = model_summary$fstatistic[1],
  DF = paste(model_summary$fstatistic[2:3], collapse = " and "),
  `P-value` = pf(model_summary$fstatistic[1],
                 model_summary$fstatistic[2],
                 model_summary$fstatistic[3],
                 lower.tail = FALSE)
)
kable(f_stat, caption = "Test istotności całego modelu")

Test istotności całego modelu

	Metric	Value	DF	P.value
value	F-statistic	279.2296	12 and 3034	0

Predykcje na zbiorze testowym

Wyniki predykcji na zbiorze testowym są oceniane za pomocą metryk jakości takich jak RMSE (Root Mean Square Error), R² (współczynnik determinacji) oraz MAE (Mean Absolute Error). Metryki te pozwalają ocenić dokładność i dopasowanie modelu do danych.

predictions <- predict(model_lm, newdata = testing_data)
post_resample <- postResample(pred = predictions,
                              obs = testing_data$Average.Voltage)
kable(post_resample, col.names = c("Metryka", "Wartość"), caption = "Ocena modelu - metryki jakości predykcji")

Ocena modelu - metryki jakości predykcji

Metryka	Wartość
RMSE	3.0194780
Rsquared	0.0708507
MAE	0.9244876

Ocena modelu

RMSE (Root Mean Square Error) obliczono jako miarę różnicy między wartościami rzeczywistymi a przewidywanymi na zbiorze testowym. Wartość ta informuje o średnim błędzie prognoz w jednostkach zmiennej celu. Wykres wizualizuje różnice między wartościami rzeczywistymi a przewidzianymi przez regresor, co ułatwia identyfikację ewentualnych wzorców błędu.

rmse <- sqrt(mean((testing_data$Average.Voltage - predictions)^2))

RMSE na zbiorze testowym: 3.019478

Poniższy wykres przedstawia wartości zbioru testowego oraz wartości przewidziane przez regresor.

prediction_comparison_df <- tibble(X = testing_data$Battery.ID,
                                   actual = testing_data$Average.Voltage,
                                   predicted = predictions)
prediction_comparison_df$Observation <- seq_along(prediction_comparison_df$X)

p <- ggplot(prediction_comparison_df, aes(x = Observation)) +
  geom_line(aes(y = actual, color = "Wartość rzeczywista"), linetype = "solid", alpha = 0.5) +
  geom_line(aes(y = predicted, color = "Wartość przewidziana"), linetype = "dashed", alpha = 0.5) +
  labs(color = "Wartości", x = "Nr obserwacji", y = "Average Voltage [V]") +
  theme_light() +
  scale_x_continuous(
    breaks = seq(1, nrow(prediction_comparison_df), by = 1000),
    labels = scales::comma_format()
  ) +
  scale_y_continuous(
    limits = c(min(prediction_comparison_df$actual, prediction_comparison_df$predicted),
               max(prediction_comparison_df$actual, prediction_comparison_df$predicted))
  ) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

interactive_plot <- ggplotly(p) %>%
  layout(
    hovermode = "x unified",
    xaxis = list(
      title = "Nr obserwacji"
    ),
    yaxis = list(
      title = "Average Voltage [V]"
    ),
    shapes = list(
      list(
        type = "line",
        x0 = 0,
        x1 = 1,
        y0 = 0,
        y1 = 1,
        line = list(color = "gray", dash = "dot")
      )
    )
  )

interactive_plot

Ważność atrybutów

Analiza ważności atrybutów pozwala zidentyfikować te cechy, które mają największy wpływ na przewidywanie zmiennej celu. Wartości ważności są wizualizowane w postaci wykresu słupkowego, co ułatwia interpretację i wybór istotnych predyktorów.

importance <- varImp(model_lm, scale = FALSE)
importance_df <- importance$importance %>%
  rownames_to_column(var = "attribute") %>%
  arrange(desc(Overall))

p <- ggplot(importance_df, aes(x = reorder(attribute, Overall), y = Overall, fill = Overall)) +
  geom_bar(stat = "identity") +
  labs(x = "Atrybut", y = "Ważność") +
  scale_fill_gradient() +
  theme_light() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

ggplotly(p)

Analizując powyższy wykres można stwierdzić, że największy wpływ na przewidywaną wartość średniego napięcia miał parametr energii wulumetrycznej oraz pojemności wolumetrycznej. Mniejszy wpływ miały również trybuty maksymalnej zmiany objętości oraz wskaźnik stabilności materiału.